home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1463.ZIP / DRAW-2D.ARC / GRINIT.PAS < prev    next >
Pascal/Delphi Source File  |  1987-06-13  |  5KB  |  183 lines
  1. FUNCTION LIMIT(VT:REAL):REAL;
  2.    BEGIN
  3.      IF VT >  1000.0 THEN VT :=  1000.0;
  4.      IF VT < -1000.0 THEN VT := -1000.0;
  5.      LIMIT := VT;
  6.    END;
  7. PROCEDURE GRINIT(XL,XH,YL,YH:INTEGER);
  8.    BEGIN
  9.      XPMIN := XL;
  10.      XPMAX := XH;
  11.      XPIX := XPMAX - XPMIN + 1;
  12.      YPMIN := YL;
  13.      YPMAX  := YH;
  14.      YPIX := YPMAX - YPMIN + 1;
  15.      XPREV := XPMIN;
  16.      YPREV := YPMAX;
  17.    END;
  18. PROCEDURE GRNDC(X1,Y1,X2,Y2:REAL);
  19.    BEGIN
  20.      XDMIN := X1;
  21.      XDMAX := X2;
  22.      YDMIN := Y1;
  23.      YDMAX := Y2;
  24.    END;
  25. PROCEDURE GRVIEW(X1,Y1,X2,Y2:REAL);
  26.    BEGIN
  27.      XVMIN := X1;
  28.      XVMAX := X2;
  29.      YVMIN := Y1;
  30.      YVMAX := Y2;
  31.    END;
  32. PROCEDURE GRWORLD(X1,Y1,X2,Y2:REAL);
  33.    BEGIN
  34.      XWMIN := X1;
  35.      XWMAX := X2;
  36.      YWMIN := Y1;
  37.      YWMAX := Y2;
  38.      X := XWMIN;
  39.      Y := YWMIN;
  40.   (* ASSUMES WORLD UNITS IN FEET *)
  41.      SCALX := (XWMAX-XWMIN)/((2.0*XPIX)/(HARDXPIX*3.0));
  42.      SCALY := (YWMAX-YWMIN)/(YPIX/(HARDYPIX*2.0));
  43.    END;
  44. PROCEDURE GRMOVE(X1,Y1:REAL; C:INTEGER);
  45.    VAR
  46.      XINT,YINT:INTEGER;
  47.      TX,TY,XRAT,YRAT:REAL;
  48.    BEGIN
  49.      XRAT := (X1-XWMIN)/(XWMAX-XWMIN);
  50.      YRAT := 1.0-(Y1-YWMIN)/(YWMAX-YWMIN);
  51.      IF ABS(X1-XWMIN) < 0.00001 THEN XINT := XPMIN
  52.            ELSE
  53.              BEGIN
  54.                TX := XRAT*XPIX + XPMIN - 1;
  55.                TX := LIMIT(TX);
  56.                XINT := ROUND(TX);
  57.              END;
  58.      IF ABS(Y1-YWMAX) < 0.00001 THEN YINT := YPMIN
  59.            ELSE
  60.              BEGIN
  61.                TY := YRAT*YPIX + YPMIN - 1;
  62.                TY := LIMIT(TY);
  63.                YINT := ROUND(TY);
  64.              END;
  65.      XPREV := XINT;
  66.      YPREV := YINT;
  67.      PLOT(XINT,YINT,C);
  68.    END;
  69. PROCEDURE GRDRAW(X1,Y1:REAL; C:INTEGER);
  70.    VAR
  71.      XINT,YINT:INTEGER;
  72.      TX,TY,XRAT,YRAT:REAL;
  73.    BEGIN
  74.      XRAT := (X1-XWMIN)/(XWMAX-XWMIN);
  75.      YRAT := 1.0-(Y1-YWMIN)/(YWMAX-YWMIN);
  76.      IF ABS(X1-XWMIN) < 0.00001 THEN XINT := XPMIN
  77.            ELSE
  78.              BEGIN
  79.                TX := XRAT*XPIX + XPMIN - 1;
  80.                TX := LIMIT(TX);
  81.                XINT := ROUND(TX);
  82.              END;
  83.      IF ABS(Y1-YWMAX) < 0.00001 THEN YINT := YPMIN
  84.            ELSE
  85.              BEGIN
  86.                TY := YRAT*YPIX + YPMIN - 1;
  87.                TY := LIMIT(TY);
  88.                YINT := ROUND(TY);
  89.              END;
  90.      DRAW(XPREV,YPREV,XINT,YINT,C);
  91.      XPREV := XINT;
  92.      YPREV := YINT;
  93.    END;
  94. PROCEDURE GRBOX(XR2,YR2,XR3,YR3:REAL; C:INTEGER);
  95.    VAR
  96.      XI2,XI3,XI4,YI2,YI3,YI4:INTEGER;
  97.      TX,TY,XRAT,YRAT:REAL;
  98.    BEGIN
  99.      XRAT := (XR2-XWMIN)/(XWMAX-XWMIN);
  100.      YRAT := 1.0-(YR2-YWMIN)/(YWMAX-YWMIN);
  101.      IF ABS(XR2-XWMIN) < 0.00001 THEN XI2 := XPMIN
  102.            ELSE
  103.              BEGIN
  104.                TX := XRAT*XPIX + XPMIN - 1;
  105.                TX := LIMIT(TX);
  106.                XI2 := ROUND(TX);
  107.              END;
  108.      IF ABS(YR2-YWMAX) < 0.00001 THEN YI2 := YPMIN
  109.            ELSE
  110.              BEGIN
  111.                TY := YRAT*YPIX + YPMIN - 1;
  112.                TY := LIMIT(TY);
  113.                YI2 := ROUND(TY);
  114.              END;
  115.      XRAT := (XR3-XWMIN)/(XWMAX-XWMIN);
  116.      YRAT := 1.0-(YR3-YWMIN)/(YWMAX-YWMIN);
  117.      IF ABS(XR3-XWMIN) < 0.00001 THEN XI3 := XPMIN
  118.            ELSE
  119.              BEGIN
  120.                TX := XRAT*XPIX + XPMIN - 1;
  121.                TX := LIMIT(TX);
  122.                XI3 := ROUND(TX);
  123.              END;
  124.      IF ABS(YR3-YWMAX) < 0.00001 THEN YI3 := YPMIN
  125.            ELSE
  126.              BEGIN
  127.                TY := YRAT*YPIX + YPMIN - 1;
  128.                TY := LIMIT(TY);
  129.                YI3 := ROUND(TY);
  130.              END;
  131.      XI4 := XI3 - (XI2-XPREV);
  132.      YI4 := YI3 - (YI2-YPREV);
  133.      DRAW(XPREV,YPREV,XI2,YI2,C);
  134.      DRAW(XI2,YI2,XI3,YI3,C);
  135.      DRAW(XI3,YI3,XI4,YI4,C);
  136.      DRAW(XI4,YI4,XPREV,YPREV,C);
  137.      XPREV := XI4;
  138.      YPREV := YI4;
  139.    END;
  140. PROCEDURE POINT(XI,YI,C:INTEGER);
  141.    BEGIN
  142.      DRAW(XI-4,YI,XI+4,YI,C);
  143.      DRAW(XI,YI-2,XI,YI+2,C);
  144.      XPREV := XI;
  145.      YPREV := YI;
  146.    END;
  147. PROCEDURE MARK(XI,YI,C:INTEGER);
  148.    BEGIN
  149.      DRAW(XI-4,YI-2,XI+4,YI+2,C);
  150.      DRAW(XI-4,YI+2,XI+4,YI-2,C);
  151.      XPREV := XI;
  152.      YPREV := YI;
  153.    END;
  154. PROCEDURE LINE(XI,YI,C:INTEGER);
  155.    BEGIN
  156.      DRAW(XPREV,YPREV,XI,YI,C);
  157.      XPREV := XI;
  158.      YPREV := YI;
  159.    END;
  160. PROCEDURE BOX(XI,YI,C:INTEGER);
  161.    BEGIN
  162.      DRAW(XPREV,YPREV,XPREV,YI,C);
  163.      DRAW(XPREV,YI,XI,YI,C);
  164.      DRAW(XI,YI,XI,YPREV,C);
  165.      DRAW(XI,YPREV,XPREV,YPREV,C);
  166.      XPREV := XI;
  167.      YPREV := YI;
  168.    END;
  169. PROCEDURE GRCIRCLE(XC,YC,RADIUS:REAL; C:INTEGER);
  170.    VAR
  171.      K:INTEGER;
  172.      X2,Y2:REAL;
  173.    BEGIN
  174.      GRMOVE(XC,YC,0);
  175.      POINT(XPREV,YPREV,C);
  176.      GRMOVE(XC+RADIUS,YC,0);
  177.      FOR K := 1 TO NPOLY DO
  178.        BEGIN
  179.          X2 := XC + RADIUS * COS(K*2*PI/NPOLY) ;
  180.          Y2 := YC + RADIUS * SIN(K*2*PI/NPOLY) ;
  181.          GRDRAW(X2,Y2,C);
  182.        END;
  183.    END;